home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / borland / jnfb88.arc / TSORT.ARC / RDSRT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-10-16  |  2.4 KB  |  94 lines
  1.  
  2. program Read_Sort_Write_Sequential_File;
  3.  
  4. type
  5.     FileName = record       (*  FileName is an 18-byte record *)
  6.                        Filenm : array[1..12] of char;
  7.                        Index  : array[1..4] of char;
  8.                        CR     : byte;
  9.                        LF     : byte;
  10.                  end;
  11.  
  12.     DirectoryFile = file of FileName;
  13.  
  14. var
  15.     Nom     : array[1..18] of char;              Results  : integer;
  16.  
  17. {$I SORT.BOX }
  18.  
  19. procedure Inp;
  20. var
  21.    rec : integer;
  22.  
  23.    f   : text;
  24. begin
  25.      ClrScr;
  26.      writeln('Preparing to sort file names.'); writeln;
  27.      writeln('Collecting file names...');     writeln;
  28.      Assign(f,'TEST.DAT');           {$I-}         Reset(f);      {$I+}
  29.  
  30.      if IOresult <> 0 then begin
  31.                            writeln('Not there.');
  32.                            end;
  33.      rec := 0;
  34.      repeat
  35.            rec := rec + 1;
  36.            write(#13, rec:6);
  37.            readln(f,Nom);
  38.            SortRelease(Nom);
  39.      until EOF(f);
  40.  
  41.      writeln(' file names collected');    writeln;
  42.      writeln('Now sorting...(this might take a few minutes).');
  43. end;
  44.  
  45.  
  46. function Less;
  47. var
  48.    FirstObject :  FileName absolute X;
  49.    SecondObject:  FileName absolute Y;
  50. begin
  51.      Less := FirstObject.Filenm < SecondObject.Filenm;
  52. end;
  53.  
  54. procedure OutP;
  55. var
  56.    i     : integer;
  57.    Thing : FileName;
  58.    g     : text;
  59. begin
  60.      writeln;
  61.      writeln('Writing temporary disk files...');
  62.      Assign(g,'TEST.OUT');
  63.      Rewrite(g);
  64.      repeat
  65.            SortReturn(Thing);
  66.  
  67.            writeln(g,Thing.Index);
  68.      until SortEOS;
  69.      close(g);
  70. end;
  71.  
  72. procedure DisplayResults(results : integer);
  73. begin
  74.   Writeln;
  75.   Writeln;
  76.   case Results of                         { display sort results     }
  77.      0 : Writeln('Returning to main program.');
  78.      3 : Writeln('Error:  not enough memory to sort');
  79.      8 : Writeln('Error:  illegal item length.');
  80.      9 : Writeln('Error:  can only sort ', MaxInt, ' records.');
  81.     10 : Writeln('Error:  disk full or disk write error.');
  82.     11 : Writeln('Error:  disk error during read.');
  83.     12 : Writeln('Error:  directory full or invalid path name');
  84.   end; (* case *)
  85. end; (* DisplayResults *)
  86.  
  87.  
  88.  
  89. begin
  90.      Results := TurboSort(SizeOf(FileName));    DisplayResults( Results );
  91. end.
  92.  
  93. ------------------------------------------------- end of Figure 1 ------
  94.